home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0001_BESTFADE.PAS.pas next >
Pascal/Delphi Source File  |  1993-05-28  |  1KB  |  90 lines
  1. {
  2. REYNIR STEFANSSON
  3.  
  4.      Here is yet another fade-in routine. This one does a proportional fade
  5. of all colours.
  6. }
  7.  
  8. Program FadeDemo;
  9.  
  10. Uses
  11.   Crt;
  12.  
  13. Const
  14.   PelAddrRgR  = $3C7;
  15.   PelAddrRgW  = $3C8;
  16.   PelDataReg  = $3C9;
  17.  
  18. Type
  19.   rgb = Record
  20.     r, g, b : Byte;
  21.   end;
  22.  
  23. Var
  24.   i   : Integer;
  25.   ch  : Char;
  26.   col : Array[0..63] of rgb;
  27.  
  28. Procedure GetCol(C : Byte; Var R, G, B : Byte);
  29. begin
  30.   Port[PelAddrRgR] := C;
  31.   R := Port[PelDataReg];
  32.   G := Port[PelDataReg];
  33.   B := Port[PelDataReg];
  34. end;
  35.  
  36. Procedure SetCol(C, R, G, B : Byte);
  37. begin
  38.   Port[PelAddrRgW] := C;
  39.   Port[PelDataReg] := R;
  40.   Port[PelDataReg] := G;
  41.   Port[PelDataReg] := B;
  42. end;
  43.  
  44. Procedure SetInten(b : Byte);
  45. Var
  46.   i  : Integer;
  47.   fr,
  48.   fg,
  49.   fb : Byte;
  50. begin
  51.   For i := 0 to 63 DO
  52.   begin
  53.     fr := col[i].r * b div 63;
  54.     fg := col[i].g * b div 63;
  55.     fb := col[i].b * b div 63;
  56.     SetCol(i, fr, fg, fb);
  57.   end;
  58. end;
  59.  
  60. begin
  61.   TextMode(LastMode);
  62.   For i := 0 to 63 DO
  63.     GetCol(i, col[i].r, col[i].g, col[i].b);
  64.   For i := 1 to 15 DO
  65.   begin
  66.     TextAttr := i;
  67.     WriteLn('Foreground colour = ', i : 2);
  68.   end;
  69.   ch := ReadKey;
  70.   For i := 63 DOWNTO 0 DO
  71.   begin
  72.     SetInten(i);
  73.     Delay(20);
  74.   end;
  75.   GotoXY(1, 1);
  76.   For i := 15 DOWNTO 1 DO
  77.   begin
  78.     TextAttr := i;
  79.     WriteLn('Foreground colour = ', i : 2);
  80.   end;
  81.  
  82.   For i := 0 to 63 DO
  83.   begin
  84.     SetInten(i);
  85.     Delay(20);
  86.   end;
  87.   ch := ReadKey;
  88.   TextMode(LastMode);
  89. end.
  90.